perm filename TRIANG.IL0[TIM,LSP] blob
sn#736741 filedate 1983-12-28 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 (FILECREATED "30-MAY-83 15:25:29" {PHYLUM}<GABRIEL>TRIANG.5 3271
C00008 ENDMK
C⊗;
(FILECREATED "30-MAY-83 15:25:29" {PHYLUM}<GABRIEL>TRIANG.;5 3271
CHANGES TO: (VARS TRIANGCOMS)
(FNS LAST-POSITION TRY TEST TRIANG-INIT GOGOGO)
PREVIOUS DATE: "30-MAY-83 13:50:41" {PHYLUM}<GABRIEL>TRIANG.;1)
(* COPYRIGHT (C) 1983 BY BOZOB CORPORATION)
(PRETTYCOMPRINT TRIANGCOMS)
(RPAQQ NTRIANGCOMS ((LOCALVARS . T)
(SPECVARS ANSWER FINAL DEEPCOUNTER)
(GLOBALVARS BOARD SEQUENCE A B C)
(FNS GOGOGO LAST-POSITION TRY TEST TRIANG-INIT)
(BLOCKS
(NTRIANGBLOCK
GOGOGO LAST-POSITION TRY TEST TRIANG-INIT
(ENTRIES GOGOGO TRIANG-INIT TEST)))
(P (TRIANG-INIT))))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(SPECVARS ANSWER FINAL DEEPCOUNTER)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS BOARD SEQUENCE A B C)
)
(DEFINEQ
(GOGOGO
(LAMBDA (I) (* JONL "30-MAY-83 13:48")
(PROG ((ANSWER NIL)
(FINAL NIL))
(RETURN (TRY I 1)))))
(LAST-POSITION
(LAMBDA NIL (* JONL "30-MAY-83 15:22")
(OR (FIND I TO 16 SUCHTHAT (EQ 1 (ELT BOARD I)))
0)))
(TRY
(LAMBDA (I DEPTH) (* JONL "30-MAY-83 15:18")
(DECLARE (SPECVARS ANSWER FINAL)
(GLOBALVARS BOARD SEQUENCE A B C))
(COND
((EQ DEPTH 14)
(PROG ((LP (LAST-POSITION)))
(COND
((MEMBER LP FINAL))
(T (PUSH FINAL LP))))
(BIND (Q ← NIL) FOR J FROM 1 TO 14 DO (PUSH Q (ELT SEQUENCE J))
FINALLY (PUSH Q ANSWER))
T)
((AND (EQ 1 (ELT BOARD (ELT A I)))
(EQ 1 (ELT BOARD (ELT B I)))
(EQ 0 (ELT BOARD (ELT C I))))
(SETA BOARD (ELT A I) 0)
(SETA BOARD (ELT B I) 0)
(SETA BOARD (ELT C I) 1)
(SETA SEQUENCE DEPTH I)
(BIND (DEPTH ←(ADD1 DEPTH)) FOR J FROM 1 TO 37 UNTIL (TRY J DEPTH) DO NIL)
(SETA BOARD (ELT A I) 1)
(SETA BOARD (ELT B I) 1)
(SETA BOARD (ELT C I) 0)
NIL))))
(TEST
(LAMBDA NIL (* JONL "30-MAY-83 15:18")
(DECLARE (SPECVARS ANSWER FINAL)
(GLOBALVARS BOARD SEQUENCE A B C))
(TRIANG-INIT)
(PROG ((ANSWER NIL)
(FINAL NIL))
(TRY 23 1)
(RETURN (EQ 775 (LENGTH ANSWER))))))
(TRIANG-INIT
(LAMBDA NIL (* JONL "30-MAY-83 15:00")
(SETQ BOARD (ARRAY 17))
(FOR I FROM 1 TO 16 DO (SETA BOARD I 1))
(SETA BOARD 5 0)
(SETQ SEQUENCE (ARRAY 15))
(SETQ A
(ARRAY 38))
(BIND (K ← 1) FOR J IN
(QUOTE (1 2 4 3 5 6 1 3 6 2 5 4 11 12 13 7 8 4 4 7 11 8 12 13 6 10 15 9 14 13 13 14
15 9 10 6 0)) DO
(SETA A K J)(SETQ K (ADD1 K)))
(SETQ B
(ARRAY 38))
(BIND (K ← 1) FOR J IN
(QUOTE (2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8 9 5 2 4 7 5 8 9 3 6 10 5 9 8 12 13 14 8
9 5 0)) DO
(SETA B K J)(SETQ K (ADD1 K)))
(SETQ C
(ARRAY 38))
(BIND (K ← 1) FOR J IN
(QUOTE (4 7 11 8 12 13 6 10 15 9 14 13 13 14 15 9 10 6 1 2 4 3 5 6 1 3 6 2 5 4 11 12
13 7 8 4 0)) DO
(SETA C K J)(SETQ K (ADD1 K)))))
)
(PUTPROPS TRIANG COPYRIGHT ("XEROX CORPORATION" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (714 3180 (GOGOGO 724 . 904) (LAST-POSITION 906 . 1089) (TRY 1091 . 1886) (TEST 1888 .
2206) (TRIANG-INIT 2208 . 3178)))))
STOP